home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / FGAUSS.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  46 lines
  1. PROGRAM d14r10(input,output);
  2. (* driver for routine FGAUSS *)
  3. CONST
  4.    npt=3;
  5.    nlin=2;
  6.    na=6;   (* na=3*nlin *)
  7. TYPE
  8.    glnparam = ARRAY [1..na] OF real;
  9. VAR
  10.    e1,e2,f,x,y : real;
  11.    i,j : integer;
  12.    a,dyda,df : glnparam;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I FGAUSS.PAS *)
  16.  
  17. BEGIN
  18.    a[1] := 3.0; a[2] := 0.2; a[3] := 0.5;
  19.    a[4] := 1.0; a[5] := 0.7; a[6] := 0.3;
  20.    writeln;
  21.    writeln('x':6,'y':8,'dyda1':9,'dyda2':8,'dyda3':8,
  22.       'dyda4':8,'dyda5':8,'dyda6':8);
  23.    FOR i := 1 to npt DO BEGIN
  24.       x := 0.3*i;
  25.       fgauss(x,a,y,dyda,na);
  26.       e1 := exp(-sqr((x-a[2])/a[3]));
  27.       e2 := exp(-sqr((x-a[5])/a[6]));
  28.       f := a[1]*e1+a[4]*e2;
  29.       df[1] := e1;
  30.       df[4] := e2;
  31.       df[2] := a[1]*e1*2.0*(x-a[2])/(a[3]*a[3]);
  32.       df[5] := a[4]*e2*2.0*(x-a[5])/(a[6]*a[6]);
  33.       df[3] := a[1]*e1*2.0*sqr(x-a[2])/(a[3]*a[3]*a[3]);
  34.       df[6] := a[4]*e2*2.0*sqr(x-a[5])/(a[6]*a[6]*a[6]);
  35.       writeln('from FGAUSS');
  36.       write(x:8:4,y:8:4);
  37.       FOR j := 1 to 6 DO write(dyda[j]:8:4);
  38.       writeln;
  39.       writeln('independent calc.');
  40.       write(x:8:4,f:8:4);
  41.       FOR j := 1 to 6 DO write(df[j]:8:4);
  42.       writeln;
  43.       writeln
  44.    END
  45. END.
  46.